
package Sgdb::DisplayWatch ;

use Sgdb::Utils qw (:DEFAULT
                    menu_pop_common_Edit
                    menu_pop_common_View
                    bind_search_mechanism
                    bind_history_mechanism
                    tab_complete_gdb_command
                    ) ;



# pragmas for all
use warnings ;
use strict ;
use integer ;
use bytes ;

# Note: future multi interface option: watch globals

our $default_cmd ;

init() ;

sub init {

    $default_cmd = pref 'display-watch-default-command' ;
    $default_cmd ||= 'out/x' ;
    1 ;
}

sub new {

    my $self = shift or die "whoami" ;
    my $topf = shift or die "top frame needed" ;

    my $text = ( pref ('display-watch-show-scrollbars') ?
                 $topf -> Scrolled ( 'ROText', pref 'display-watch-text' ) :
                 $topf ->             ROText ( pref 'display-watch-text' ) ) ;

#    balloonset $text =><<DoC ;
#This pane is used to monitor data collected once 
#you have set and sent traces to your targtes. 
#The output is refreshed whenever you proceed 
#to the next frame, for example, when issuing 
#tfind, step, next, etc. If you have set frames 
#collecting locals and arguments, you will be 
#able to view 'info locals' and 'info args' 
#in this pane. Use sensitive search within 
#this text widget by pressing Ctrl s/r/S/R/g. 
#Right-click to enable common edit and view commands.
#DoC

    pref_tags $text, 'display-watch', qw/value expr expr-cmd/ ;
    { # menu
        my $m = $text -> menu() ;
        $m -> configure ( -postcommand => [\&popup_display_menu,
                                           $text,
                                           menu_pop_common_Edit ( $text, $m -> Menu ( -tearoff => 0, pref( 'pop-menu') ) ),
                                           menu_pop_common_View ( $text, $m -> Menu ( -tearoff => 0, pref( 'pop-menu') ) ),
                                           ]) ;
    }
    $text -> bind ("<Meta-Up>"   =>  sub {}) ;
    $text -> bind ("<Meta-Down>" =>  sub {}) ;

    my $newcmd ;
    my $e = $topf -> Entry ( -textvariable => \$newcmd,
                             pref 'display-watch-entry'
                             ) -> pack ( -side => 'top',
                                         -fill => 'x',
                                         -anchor => 'sw',
                                         -expand => 0,
                                         ) ;


    balloonset $e =><<DoC ;
Enter the Sgdb commands to examine the current 
frame. You can specify a particular output 
format out/t/d/f.
DoC

    $e -> bind ("<Tab>"    => [\&tab_complete_gdb_command, "$default_cmd "] ) ;

    my $hcb = bind_history_mechanism ( $e, \$newcmd ) ;

    $e -> bind ("<Return>" => [\&add_new_value,     $text, $hcb, \$newcmd]) ;
    hook_add ( 'add-watch'   => [\&add_new_value, $e, $text, $hcb ],
               'add-display-watch' => [ \&focus_on, $e ],
             ) ;

    bind_search_mechanism $text, $e ;

    pref_reconfigure ( 'display-watch-text' => $text,
                       'display-watch-entry' => $e
                       ) ;

    # Return:
    # 1. unpacked text object
    # 2. update command
    ($text,
     sub { frame_update( $text, @_ ) },
     ) ;
}

sub popup_display_menu {

    my ($t, $sm_Edit, $sm_View )  = @_ ;

    my $current  = $t -> index ( 'current' ) ;

    my $m = $t -> menu () ;
    $m -> delete ( 0 => 'end' ) ;

    my ( $c_start, $c_end, $v_start, $v_end ) ;

    if ( ($c_start, $c_end ) = $t -> tagPrevrange( 'expr', "$current lineend") and
         ($v_start, $v_end ) = $t -> tagNextrange( 'value', $c_end ) and
         $t -> compare ( $c_start, '<', $v_end ) ) {

        my $cmd = $t -> get ( $c_start, $c_end ) ;

        foreach my $menu ( ['command',
                            -label => 'Delete',
                            -command => [$t => 'delete', $c_start, $v_end]
                            ],
                           ['command',
                            -label => 'Delete All' ,
                            -command => [$t => 'delete', '1.0', 'end' ],
                            ],
                           ( ( $cmd =~ s/^ // ) ?
                             (['separator'
                               ],
                              ['command',
                               -label => "watch \*$cmd",
                               -command => [\&hook_run, 'add-watch', "\*$cmd"],
                               ],
                              ['command',
                               -label => "watch \&$cmd",
                               -command => [\&hook_run, 'add-watch', "\&$cmd"],
                               ],
                              ) : () ),
                           ['separator'
                            ],
                           ) { $m -> add ( @$menu ) }
    }

    foreach my $menu ( ['cascade',
                        -label => 'Edit',
                        -menu => $sm_Edit
                        ],
                       ['cascade',
                        -label => 'View',
                        -menu => $sm_View
                        ],
                       ['separator'
                        ],
                       ['command',
                        -label => 'Close',
                        -command => [\&hook_run, 'close-current-data-pane' ]
                        ],
                       ) { $m -> add ( @$menu ) }

}

sub frame_update {

    return unless gdb_cached 'is-alive' ;

    my $text = shift ;

    my @ranges ;

    @ranges = reverse $text -> tagRanges( 'value' ) ;

    while ( @ranges ) {

        my $end = shift @ranges ;
        my $start = shift @ranges or return telme $end ;

        my $cmd = $text -> get ( $text -> tagPrevrange ( 'expr', $start ) );

        $cmd = $default_cmd . $cmd if ' ' eq substr $cmd, 0, 1 ;

        my $value = get_value( $cmd ) ;

        $text -> delete ( $start => $end ) ;
        $text -> insert ( $start,
                          $value => 'value'
                          ) ;
    }
}

sub get_value {

    my $cmd = shift ;

    my $res = gdb_exec_quiet ( $cmd ) ;
    $res ||= 'Undefined' ;
    $res =~ s/\s*\z/\n/ ;
    $res = "\n$res" if $res =~ tr/\n// > 1 ;

    $res ;
}

sub add_new_value {

    return telthemloud 'No Active Debugger' unless gdb_cached 'is-alive' ;

    busy ;
    my ($e, $t, $hcb, $ref)  = @_ ;

    my $cmd ;
    if ( ref $ref ) { $cmd = $$ref ; $$ref = '' }
    else            { $cmd =  $ref }

    if ( $cmd =~ /\w/ ) {

        my $type ;
        my $res  ;

        $res = get_value ( $cmd ) if $cmd =~ /\S\s+\S/ ;

        if ( !$res or $res =~ /^Undefined command/ ) {

            $res = get_value ( $default_cmd . ' ' . $cmd ) ;

            $t -> insert ( 'end',
                           ' ' . $cmd." " => 'expr',
                           $res            => 'value'
                           ) ;
        }
        else {
            $t -> insert ( 'end',
                           "$cmd " => ['expr',  "expr-cmd" ],
                           $res    => 'value'
                           ) ;
        }
    }
    else {
        frame_update ( $t ) ;
    }

    unbusy ;

    $hcb -> ( $cmd ) ;
}

